home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / tpwplay.zip / PLAYDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-13  |  4KB  |  163 lines
  1. unit PlayDlg;
  2. {
  3.   Copyright (c) June 1993, by Charlie Calvert
  4.   Feel free to use this code as an adjunct to your own programs.
  5. }
  6.  
  7. interface
  8. uses
  9.   CommDlg, MMSystem, Strings, Objects, ODialogs,
  10.   OWindows, PlayerID, WinDos, WinProcs, WinTypes;
  11.  
  12. const
  13.   DDL_READWRITE = $0000;
  14.   DDL_READONLY  = $0001;
  15.   DDL_HIDDEN    = $0002;
  16.   DDL_SYSTEM    = $0004;
  17.   DDL_DIRECTORY = $0010;
  18.   DDL_ARCHIVE   = $0020;
  19.   DDL_POSTMSGS  = $2000;
  20.   DDL_DRIVES    = $4000;
  21.   DDL_EXCLUSIVE = $8000;
  22.  
  23.   PlayTimer = 1;
  24.   MidiError = - 251;
  25.   MaxLen = 150;
  26.   MinLen = 50;
  27.   MaxSize = 150;
  28.  
  29. type
  30.   PPlayDialog = ^TPlayDialog;
  31.   TPlayDialog = Object(TDialog)
  32.       WildCard,
  33.       CurrentDirectory,
  34.       FileTitle: array[0..MaxLen] of Char;
  35.       BlueBrush,
  36.       Pattern: HBrush;
  37.       Mode: LongInt;
  38.       DevStatus: PChar;
  39.     constructor Init(AParent: PWindowsObject; AName: PChar);
  40.     destructor Done; virtual;
  41.     procedure SetUpWindow; virtual;
  42.     procedure ReportStatus; virtual;
  43.     procedure GetStatus; virtual;
  44.     procedure StartTimer;
  45.     procedure FileFill(var Msg: TMessage);
  46.       virtual id_First + id_FileFill;
  47.     procedure WMControlColor(var Msg: TMessage);
  48.       virtual wm_First + wm_CtlColor;
  49.   end;
  50.  
  51. implementation
  52.  
  53. constructor TPlayDialog.Init(AParent: PWindowsObject; AName: PChar);
  54. begin
  55.   inherited Init(AParent, AName);
  56.   GetMem(DevStatus, MinLen);
  57. end;
  58.  
  59. destructor TPlayDialog.Done;
  60. begin
  61.   if BlueBrush <> 0 then DeleteObject(Pattern);
  62.   FreeMem(DevStatus, MinLen);
  63.   inherited Done;
  64. end;
  65.  
  66. procedure TPlayDialog.SetUpWindow;
  67. begin
  68.   inherited SetUpWindow;
  69.   Pattern := GetStockObject(Gray_Brush);
  70.   BlueBrush := CreateSolidBrush(RGB(0, 0, 64));
  71. end;
  72.  
  73. procedure SplitDirName(Path : PChar; Dir: PChar; WName: PChar);
  74. var
  75.   Name: NameStr;
  76.   Ext: ExtStr;
  77. begin
  78.   FileSplit(Path,Dir,Name,Ext);
  79.   Dir[StrLen(Dir) - 1] := #0;
  80.   StrCopy(WName, Name);
  81.   StrCat(WName, Ext);
  82. end;
  83.  
  84. procedure TPlayDialog.FileFill;
  85. Const
  86.   szDefExt = 'Sd';
  87.   FileNameMax = 100;
  88. var
  89.   OpenFN: TOpenFileName;
  90.   FileTitle2: PChar;
  91.   WinDir: array[0..145] of Char;
  92.  
  93. begin
  94.   GetMem(FileTitle2, MaxSize);
  95.   StrCopy(FileTitle2, WildCard);
  96.   FillChar(OpenFN, SizeOf(TOpenFileName), #0);
  97.   with OpenFN do begin
  98.     hInstance       := HInstance;
  99.     hwndOwner       := HWindow;
  100.     lpstrDefExt     := szDefExt;
  101.     lpstrFile       := FileTitle2;
  102.     lpstrInitialDir := 'c:\windows';
  103.     lpstrFilter     := 'Server Demo';
  104.     lpstrFileTitle  := FileTitle;
  105.     lStructSize     := sizeof(TOPENFILENAME);
  106.     nFilterIndex    := 1;
  107.     nMaxFile        := FilenameMax;
  108.   end;
  109.   if GetOpenFileName(OpenFN) then begin
  110.     SplitDirName(FileTitle2, CurrentDirectory, FileTitle);
  111.     SendMessage(HWindow, WM_FILLDIR, 0, 0);
  112.   end;
  113.   FreeMem(FileTitle2, MaxSize);
  114. end;
  115.  
  116. procedure TPlayDialog.GetStatus;
  117. begin
  118.   case Mode of
  119.     Mci_Mode_Not_Ready: StrCopy(DevStatus, 'Not Ready');
  120.     Mci_Mode_Pause: StrCopy(DevStatus, 'Pause');
  121.     Mci_Mode_Play: StrCopy(DevStatus, 'Play');
  122.     Mci_Mode_Stop: StrCopy(DevStatus, 'Stop');
  123.     Mci_Mode_Open: StrCopy(DevStatus, 'Open');
  124.     Mci_Mode_Record: StrCopy(DevStatus, 'Recording');
  125.     Mci_Mode_Seek: StrCopy(DevStatus, 'Seeking');
  126.   else begin
  127.     Mode := MidiError;
  128.     StrCopy(DevStatus, 'Error?');
  129.   end;
  130.   end;
  131.   SendDlgItemMessage(HWindow, 125, WM_SETTEXT, 0, LongInt(DevStatus));
  132. end;
  133.  
  134. procedure TPlayDialog.ReportStatus;
  135. begin
  136.   Abstract;
  137. end;
  138.  
  139. procedure TPlayDialog.StartTimer;
  140. begin
  141.   if (SetTimer(HWindow, PlayTimer, 250, nil) = 0) then
  142.     MessageBox(HWindow, 'No Timers!', 'Whoops!', mb_Ok + mb_IconExclamation);
  143. end;
  144.  
  145. procedure TPlayDialog.WMControlColor(var Msg: TMessage);
  146. begin
  147.   case Msg.LParamHi of
  148.     ctlColor_Static, ctlcolor_ListBox, ctlColor_Edit, ctlColor_Btn:
  149.       begin
  150.         SetTextColor(Msg.WParam, Rgb(255, 255, 0));
  151.         SetBkMode(Msg.WParam, Transparent);
  152.         Msg.Result := BlueBrush;
  153.       end;
  154.     ctlcolor_Dlg:
  155.       begin
  156.         SetBkMode(Msg.WParam, Transparent);
  157.     Msg.Result := Pattern;
  158.       end;
  159.   else
  160.     DefWndProc(Msg);
  161.   end;
  162. end;
  163. end.